home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / lang / perl_src.lha / fsf / perl / vms / vmsish.h < prev    next >
Encoding:
C/C++ Source or Header  |  1996-03-25  |  14.6 KB  |  426 lines
  1. /*  vmsish.h
  2.  *
  3.  * VMS-specific C header file for perl5.
  4.  *
  5.  * Last revised: 01-Oct-1995 by Charles Bailey  bailey@genetics.upenn.edu
  6.  * Version: 5.1.6
  7.  */
  8.  
  9. #ifndef __vmsish_h_included
  10. #define __vmsish_h_included
  11.  
  12. #include <descrip.h> /* for dirent struct definitions */
  13. #include <libdef.h>  /* status codes for various places */
  14. #include <rmsdef.h>  /* at which errno and vaxc$errno are */
  15. #include <ssdef.h>   /* explicitly set in the perl source code */
  16.  
  17. /* Suppress compiler warnings from DECC for VMS-specific extensions:
  18.  * GLOBALEXT, NOSHAREEXT: global[dr]ef declarations
  19.  * ADDRCONSTEXT: initialization of data with non-constant values
  20.  *               (e.g. pointer fields of descriptors)
  21.  */
  22. #ifdef __DECC
  23. #  pragma message disable (GLOBALEXT,NOSHAREEXT,ADDRCONSTEXT)
  24. #endif
  25.  
  26. /* Suppress compiler warnings from DECC for VMS-specific extensions:
  27.  * GLOBALEXT, NOSHAREEXT: global[dr]ef declarations
  28.  * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
  29.  *                            (e.g. pointer fields of descriptors)
  30.  */
  31. #ifdef __DECC
  32. #  pragma message disable (GLOBALEXT,NOSHAREEXT,ADDRCONSTEXT,NEEDCONSTEXT)
  33. #endif
  34.  
  35. /* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */
  36. #ifdef _toupper
  37. #  undef _toupper
  38. #endif
  39. #define _toupper(c) (((c) < 'a' || (c) > 'z') ? (c) : (c) & ~040)
  40. #ifdef _tolower
  41. #  undef _tolower
  42. #endif
  43. #define _tolower(c) (((c) < 'A' || (c) > 'Z') ? (c) : (c) | 040)
  44. /* DECC 1.3 has a funny definition of abs; it's fixed in DECC 4.0, so this
  45.  * can go away once DECC 1.3 isn't in use any more. */
  46. #if defined(__ALPHA) && defined(__DECC)
  47. #undef abs
  48. #define abs(__x)        __ABS(__x)
  49. #undef labs
  50. #define labs(__x)        __LABS(__x)
  51. #endif /* __ALPHA && __DECC */
  52.  
  53. /* Assorted things to look like Unix */
  54. #ifdef __GNUC__
  55. #ifndef _IOLBF /* gcc's stdio.h doesn't define this */
  56. #define _IOLBF 1
  57. #endif
  58. #endif
  59. #include <processes.h> /* for vfork() */
  60. #include <unixio.h>
  61. #include <unixlib.h>
  62. #include <file.h>  /* it's not <sys/file.h>, so don't use I_SYS_FILE */
  63.  
  64. /* Our own contribution to PerlShr's global symbols . . . */
  65. #ifdef EMBED
  66. #  define my_trnlnm        Perl_my_trnlnm
  67. #  define my_getenv        Perl_my_getenv
  68. #  define my_crypt        Perl_my_crypt
  69. #  define waitpid        Perl_waitpid
  70. #  define my_gconvert        Perl_my_gconvert
  71. #  define do_rmdir        Perl_do_rmdir
  72. #  define kill_file        Perl_kill_file
  73. #  define my_utime        Perl_my_utime
  74. #  define fileify_dirspec    Perl_fileify_dirspec
  75. #  define fileify_dirspec_ts    Perl_fileify_dirspec_ts
  76. #  define pathify_dirspec    Perl_pathify_dirspec
  77. #  define pathify_dirspec_ts    Perl_pathify_dirspec_ts
  78. #  define tounixspec        Perl_tounixspec
  79. #  define tounixspec_ts        Perl_tounixspec_ts
  80. #  define tovmsspec        Perl_tovmsspec
  81. #  define tovmsspec_ts        Perl_tovmsspec_ts
  82. #  define tounixpath        Perl_tounixpath
  83. #  define tounixpath_ts        Perl_tounixpath_ts
  84. #  define tovmspath        Perl_tovmspath
  85. #  define tovmspath_ts        Perl_tovmspath_ts
  86. #  define getredirection    Perl_getredirection
  87. #  define opendir        Perl_opendir
  88. #  define readdir        Perl_readdir
  89. #  define telldir        Perl_telldir
  90. #  define seekdir        Perl_seekdir
  91. #  define closedir        Perl_closedir
  92. #  define vmsreaddirversions    Perl_vmsreaddirversions
  93. #  define getredirection    Perl_getredirection
  94. #  define my_gmtime        Perl_my_gmtime
  95. #  define cando_by_name        Perl_cando_by_name
  96. #  define flex_fstat        Perl_flex_fstat
  97. #  define flex_stat        Perl_flex_stat
  98. #  define trim_unixpath        Perl_trim_unixpath
  99. #  define vms_do_aexec        Perl_vms_do_aexec
  100. #  define vms_do_exec        Perl_vms_do_exec
  101. #  define do_aspawn        Perl_do_aspawn
  102. #  define do_spawn        Perl_do_spawn
  103. #  define my_fwrite        Perl_my_fwrite
  104. #  define my_getpwnam        Perl_my_getpwnam
  105. #  define my_getpwuid        Perl_my_getpwuid
  106. #  define my_getpwent        Perl_my_getpwent
  107. #  define my_endpwent        Perl_my_endpwent
  108. #  define my_getlogin        Perl_my_getlogin
  109. #  define rmscopy        Perl_rmscopy
  110. #  define init_os_extras    Perl_init_os_extras
  111. #endif
  112.  
  113. /* Delete if at all possible, changing protections if necessary. */
  114. #define unlink kill_file
  115.  
  116. /*  The VMS C RTL has vfork() but not fork().  Both actually work in a way
  117.  *  that's somewhere between Unix vfork() and VMS lib$spawn(), so it's
  118.  *  probably not a good idea to use them much.  That said, we'll try to
  119.  *  use vfork() in either case.
  120.  */
  121. #define fork vfork
  122.  
  123. /* Macros to set errno using the VAX thread-safe calls, if present */
  124. #if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA)
  125. #  define set_errno(v)      (cma$tis_errno_set_value(v))
  126. #  define set_vaxc_errno(v) (vaxc$errno = (v))
  127. #else
  128. #  define set_errno(v)      (errno = (v))
  129. #  define set_vaxc_errno(v) (vaxc$errno = (v))
  130. #endif
  131.  
  132. /* Handy way to vet calls to VMS system services and RTL routines. */
  133. #define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \
  134.   if (!((__ckvms_sts=(call))&1)) { \
  135.   set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
  136.   croak("Fatal VMS error (status=%d) at %s, line %d", \
  137.   __ckvms_sts,__FILE__,__LINE__); } } STMT_END
  138.  
  139. #ifdef VMS_DO_SOCKETS
  140. #include "sockadapt.h"
  141. #endif
  142.  
  143. #define BIT_BUCKET "_NLA0:"
  144. #define PERL_SYS_INIT(c,v)  getredirection((c),(v))
  145. #define PERL_SYS_TERM()
  146. #define dXSUB_SYS int dummy
  147. #define HAS_KILL
  148. #define HAS_WAIT
  149.  
  150. /* VMS:
  151.  *    This symbol, if defined, indicates that the program is running under
  152.  *    VMS.  It's a symbol automagically defined by all VMS C compilers I've seen.
  153.  * Just in case, however . . . */
  154. #ifndef VMS
  155. #define VMS        /**/
  156. #endif
  157.  
  158. /* HAS_IOCTL:
  159.  *    This symbol, if defined, indicates that the ioctl() routine is
  160.  *    available to set I/O characteristics
  161.  */
  162. #undef    HAS_IOCTL        /**/
  163.  
  164. /* HAS_UTIME:
  165.  *    This symbol, if defined, indicates that the routine utime() is
  166.  *    available to update the access and modification times of files.
  167.  */
  168. #define HAS_UTIME        /**/
  169.  
  170. /* HAS_GROUP
  171.  *    This symbol, if defined, indicates that the getgrnam(),
  172.  *    getgrgid(), and getgrent() routines are available to 
  173.  *    get group entries.
  174.  */
  175. #undef HAS_GROUP        /**/
  176.  
  177. /* HAS_PASSWD
  178.  *    This symbol, if defined, indicates that the getpwnam(),
  179.  *    getpwuid(), and getpwent() routines are available to 
  180.  *    get password entries.
  181.  */
  182. #define HAS_PASSWD        /**/
  183.  
  184. #define HAS_KILL
  185. #define HAS_WAIT
  186.   
  187. /*
  188.  * fwrite1() should be a routine with the same calling sequence as fwrite(),
  189.  * but which outputs all of the bytes requested as a single stream (unlike
  190.  * fwrite() itself, which on some systems outputs several distinct records
  191.  * if the number_of_items parameter is >1).
  192.  */
  193. #define fwrite1 my_fwrite
  194.  
  195. /* Use our own rmdir() */
  196. #define rmdir(name) do_rmdir(name)
  197.  
  198. /* Assorted fiddling with sigs . . . */
  199. # include <signal.h>
  200. #define ABORT() abort()
  201.  
  202. /* Used with our my_utime() routine in vms.c */
  203. struct utimbuf {
  204.   time_t actime;
  205.   time_t modtime;
  206. };
  207. #define utime my_utime
  208.  
  209. /* This is what times() returns, but <times.h> calls it tbuffer_t on VMS */
  210.  
  211. struct tms {
  212.   clock_t tms_utime;    /* user time */
  213.   clock_t tms_stime;    /* system time - always 0 on VMS */
  214.   clock_t tms_cutime;   /* user time, children */
  215.   clock_t tms_cstime;   /* system time, children - always 0 on VMS */
  216. };
  217.  
  218. /* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always
  219.  * returned NULL.  Substitute our own routine, which uses the logical
  220.  * SYS$TIMEZONE_DIFFERENTIAL, whcih the native UTC support routines
  221.  * in VMS 6.0 or later use.*
  222.  */
  223. #define gmtime(t) my_gmtime(t)
  224.  
  225. /* VMS doesn't use a real sys_nerr, but we need this when scanning for error
  226.  * messages in text strings . . .
  227.  */
  228.  
  229. #define sys_nerr EVMSERR  /* EVMSERR is as high as we can go. */
  230.  
  231. /* Look up new %ENV values on the fly */
  232. #define DYNAMIC_ENV_FETCH 1
  233. #define ENV_HV_NAME "%EnV%VmS%"
  234.  
  235. /* Thin jacket around cuserid() tomatch Unix' calling sequence */
  236. #define getlogin my_getlogin
  237.  
  238. /* Ditto for sys$hash_passwrod() . . . */
  239. #define crypt  my_crypt
  240.  
  241. /* Use our own stat() clones, which handle Unix-style directory names */
  242. #define Stat(name,bufptr) flex_stat(name,bufptr)
  243. #define Fstat(fd,bufptr) flex_fstat(fd,bufptr)
  244.  
  245. /* By default, flush data all the way to disk, not just to RMS buffers */
  246. #define Fflush(fp) ((fflush(fp) || fsync(fileno(fp))) ? EOF : 0)
  247.  
  248. /* Setup for the dirent routines:
  249.  * opendir(), closedir(), readdir(), seekdir(), telldir(), and
  250.  * vmsreaddirversions(), and preprocessor stuff on which these depend:
  251.  *    Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
  252.  *    This code has no copyright.
  253.  */
  254.     /* Data structure returned by READDIR(). */
  255. struct dirent {
  256.     char    d_name[256];        /* File name        */
  257.     int        d_namlen;            /* Length of d_name */
  258.     int        vms_verscount;        /* Number of versions    */
  259.     int        vms_versions[20];    /* Version numbers    */
  260. };
  261.  
  262.     /* Handle returned by opendir(), used by the other routines.  You
  263.      * are not supposed to care what's inside this structure. */
  264. typedef struct _dirdesc {
  265.     long            context;
  266.     int                vms_wantversions;
  267.     unsigned long int           count;
  268.     char            *pattern;
  269.     struct dirent        entry;
  270.     struct dsc$descriptor_s    pat;
  271. } DIR;
  272.  
  273. #define rewinddir(dirp)        seekdir((dirp), 0)
  274.  
  275. /* used for our emulation of getpw* */
  276. struct passwd {
  277.         char    *pw_name;    /* Username */
  278.         char    *pw_passwd;
  279.         Uid_t   pw_uid;      /* UIC member number */
  280.         Gid_t   pw_gid;      /* UIC group  number */
  281.         char    *pw_comment; /* Default device/directory (Unix-style) */
  282.         char    *pw_gecos;   /* Owner */
  283.         char    *pw_dir;     /* Default device/directory (VMS-style) */
  284.         char    *pw_shell;   /* Default CLI name (eg. DCL) */
  285. };
  286. #define pw_unixdir pw_comment  /* Default device/directory (Unix-style) */
  287. #define getpwnam my_getpwnam
  288. #define getpwuid my_getpwuid
  289. #define getpwent my_getpwent
  290. #define endpwent my_endpwent
  291. #define setpwent my_endpwent
  292.  
  293. /* Our own stat_t substitute, since we play with st_dev and st_ino -
  294.  * we want atomic types so Unix-bound code which compares these fields
  295.  * for two files will work most of the time under VMS.
  296.  * N.B. 1. The st_ino hack assumes that sizeof(unsigned short[3]) ==
  297.  * sizeof(unsigned) + sizeof(unsigned short).  We can't use a union type
  298.  * to map the unsigned int we want and the unsigned short[3] the CRTL
  299.  * returns into the same member, since gcc has different ideas than DECC
  300.  * and VAXC about sizing union types.
  301.  * N.B 2. The routine cando() in vms.c assumes that &stat.st_ino is the
  302.  * address of a FID.
  303.  */
  304. /* First, grab the system types, so we don't clobber them later */
  305. #include <stat.h>
  306. /* Since we've got to match the size of the CRTL's stat_t, we need
  307.  * to mimic DECC's alignment settings.
  308.  */
  309. #if defined(__DECC) || defined(__DECCXX)
  310. #  pragma __member_alignment __save
  311. #  pragma __nomember_alignment
  312. #endif
  313. #if defined(__DECC) 
  314. #  pragma __message __save
  315. #  pragma __message disable (__MISALGNDSTRCT)
  316. #  pragma __message disable (__MISALGNDMEM)
  317. #endif
  318. struct mystat
  319. {
  320.         char *st_devnam;  /* pointer to device name */
  321.         unsigned st_ino;    /* hack - CRTL uses unsigned short[3] for */
  322.         unsigned short rvn; /* FID (num,seq,rvn) */
  323.         unsigned short st_mode;    /* file "mode" i.e. prot, dir, reg, etc. */
  324.         int    st_nlink;    /* for compatibility - not really used */
  325.         unsigned st_uid;    /* from ACP - QIO uic field */
  326.         unsigned short st_gid;    /* group number extracted from st_uid */
  327.         dev_t   st_rdev;    /* for compatibility - always zero */
  328.         off_t   st_size;    /* file size in bytes */
  329.         unsigned st_atime;    /* file access time; always same as st_mtime */
  330.         unsigned st_mtime;    /* last modification time */
  331.         unsigned st_ctime;    /* file creation time */
  332.         char    st_fab_rfm;    /* record format */
  333.         char    st_fab_rat;    /* record attributes */
  334.         char    st_fab_fsz;    /* fixed header size */
  335.         unsigned st_dev;    /* encoded device name */
  336. };
  337. #define stat mystat
  338. typedef unsigned mydev_t;
  339. #define dev_t mydev_t
  340. typedef unsigned myino_t;
  341. #define ino_t myino_t
  342. #if defined(__DECC) || defined(__DECCXX)
  343. #  pragma __member_alignment __restore
  344. #endif
  345. #if defined(__DECC) 
  346. #  pragma __message __restore
  347. #endif
  348. /* Cons up a 'delete' bit for testing access */
  349. #define S_IDUSR (S_IWUSR | S_IXUSR)
  350. #define S_IDGRP (S_IWGRP | S_IXGRP)
  351. #define S_IDOTH (S_IWOTH | S_IXOTH)
  352.  
  353. /* Prototypes for functions unique to vms.c.  Don't include replacements
  354.  * for routines in the mainline source files excluded by #ifndef VMS;
  355.  * their prototypes are already in proto.h.
  356.  *
  357.  * In order to keep Gen_ShrFls.Pl happy, functions which are to be made
  358.  * available to images linked to PerlShr.Exe must be declared between the
  359.  * __VMS_PROTOTYPES__ and __VMS_SEPYTOTORP__ lines, and must be in the form
  360.  *    <data type><TAB>name<WHITESPACE>_((<prototype args>));
  361.  */
  362. /* prototype section start marker; `typedef' passes through cpp */
  363. typedef char  __VMS_PROTOTYPES__;
  364. int    my_trnlnm _((char *, char *, unsigned long int));
  365. char *    my_getenv _((char *));
  366. char *    my_crypt _((const char *, const char *));
  367. unsigned long int    waitpid _((unsigned long int, int *, int));
  368. char *    my_gconvert _((double, int, int, char *));
  369. int    do_rmdir _((char *));
  370. int    kill_file _((char *));
  371. int    my_utime _((char *, struct utimbuf *));
  372. char *    fileify_dirspec _((char *, char *));
  373. char *    fileify_dirspec_ts _((char *, char *));
  374. char *    pathify_dirspec _((char *, char *));
  375. char *    pathify_dirspec_ts _((char *, char *));
  376. char *    tounixspec _((char *, char *));
  377. char *    tounixspec_ts _((char *, char *));
  378. char *    tovmsspec _((char *, char *));
  379. char *    tovmsspec_ts _((char *, char *));
  380. char *    tounixpath _((char *, char *));
  381. char *    tounixpath_ts _((char *, char *));
  382. char *    tovmspath _((char *, char *));
  383. char *    tovmspath_ts _((char *, char *));
  384. void    getredirection _(());
  385. DIR *    opendir _((char *));
  386. struct dirent *    readdir _((DIR *));
  387. long    telldir _((DIR *));
  388. void    seekdir _((DIR *, long));
  389. void    closedir _((DIR *));
  390. void    vmsreaddirversions _((DIR *, int));
  391. void    getredirection _((int *, char ***));
  392. struct tm *my_gmtime _((const time_t *));
  393. I32    cando_by_name _((I32, I32, char *));
  394. int    flex_fstat _((int, struct stat *));
  395. int    flex_stat _((char *, struct stat *));
  396. int    trim_unixpath _((char *, char*));
  397. bool    vms_do_aexec _((SV *, SV **, SV **));
  398. bool    vms_do_exec _((char *));
  399. unsigned long int    do_aspawn _((SV *, SV **, SV **));
  400. unsigned long int    do_spawn _((char *));
  401. int    my_fwrite _((void *, size_t, size_t, FILE *));
  402. struct passwd *    my_getpwnam _((char *name));
  403. struct passwd *    my_getpwuid _((Uid_t uid));
  404. struct passwd *    my_getpwent _(());
  405. void    my_endpwent _(());
  406. char *    my_getlogin _(());
  407. int    rmscopy _((char *, char *, int));
  408. void    init_os_extras _(());
  409. typedef char __VMS_SEPYTOTORP__;
  410. /* prototype section end marker; `typedef' passes through cpp */
  411.  
  412. #ifndef VMS_DO_SOCKETS
  413. /* This relies on tricks in perl.h to pick up that these manifest constants
  414.  * are undefined and set up conversion routines.  It will then redefine
  415.  * these manifest constants, so the actual values will match config.h
  416.  */
  417. #undef HAS_HTONS
  418. #undef HAS_NTOHS
  419. #undef HAS_HTONL
  420. #undef HAS_NTOHL
  421. #endif
  422.  
  423. #define TMPPATH "sys$scratch:perl-eXXXXXX"
  424.  
  425. #endif  /* __vmsish_h_included */
  426.